Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / tss15.arc / TSSFUNCT.PRG < prev next >

Wrap

Text File | 1986-03-17 | 8.0 KB | 393 lines

***************************************************************************** * * TSSFUNCT.PRG * * Time Sheet System (TSS) Function Library * * 07/85 aj sieker * updated 03/14/86 ajs * ***************************************************************************** ***************************************************************************** * * browse routine for up to 4 fields * * * usage : x=brow('field1','field2','field3','field4') * * fields not used should be nulls, (' ', a single space). * * possible fields are CONTRACT, EMPL_NO, DEPT, LAST_NAME, FIRST_NAME, HOURS * * the first field name (field1) passed is the key field (indexed on) * and will be used with the SEEK command * * field4, when used, is assumed to be a numeric field * ***************************************************************************** ***************************************************************************** * PROCEDURE BROW PARAMETERS F1,F2,F3,F4 SET DELETED OFF ROW=0 ROW_TOP=3 ROW_BOTT=21 REC_PAGE=ROW_BOTT-ROW_TOP REC_TOP=0 REC_BOTT=0 COMMLINE='PgUp, PgDn, <S>eek, <E>dit, <A>dd, <Q>uit, (cursor keys)' CLEAR DO CASE CASE F1=' ' RETURN CASE F2=' ' DISPLINE="&F1" FC=1 CASE F3=' ' DISPLINE="&F1+' '+&F2" FC=2 CASE F4=' ' DISPLINE="&F1+' '+&F2+' '+&F3" FC=3 OTHERWISE DISPLINE="&F1+' '+&F2+' '+&F3+' '+STR(&F4,5,1)" FC=4 ENDCASE M_BF1=SPACE(LEN(&F1)) IF FC>1 M_BF2=SPACE(LEN(&F2)) IF FC>2 M_BF3=SPACE(LEN(&F3)) IF FC>3 M_BF4=0.0 ENDIF ENDIF ENDIF * define special keys (cursor movement, etc) * M_PGUP=18 M_PGDN=3 M_UP=5 && CURSOR M_DN=24 && CURSOR M_HOME=1 M_DEL=21 && CTRL-U SEL=' ' MAX_ROW=22 @ 1,0 SAY 'Rec ' @ 1,40 SAY 'Time Sheet System Browse Mode' COL=1 * display field names - truncate to field width * @ 2,COL SAY SUBS(F1,1,LEN(&F1)) COL=COL+1+LEN(&F1) IF FC>1 @ 2,COL SAY SUBS(F2,1,LEN(&F2)) COL=COL+1+LEN(&F2) IF FC>2 @ 2,COL SAY SUBS(F3,1,LEN(&F3)) COL=COL+1+LEN(&F3) IF FC>3 @ 2,COL SAY F4 ENDIF ENDIF ENDIF DO BROWPAGE @ 24,0 SAY COMMLINE KEY=0 DO WHILE SEL#'Q' .AND. KEY#27 @ 1,4 SAY RECNO() PICT '99999' KEY=0 DO WHILE KEY=0 KEY=INKEY() ENDDO SEL=UPPER(CHR(KEY)) DO CASE CASE SEL='F' .OR. KEY=M_DN .OR. KEY=50 DO BROWDOWN CASE SEL='R' .OR. KEY=M_UP .OR. KEY=56 DO BROWUP CASE SEL='S' DO BROWSEEK CASE SEL='E' DO BROWEDIT CASE SEL='U' .OR. KEY=M_DEL DO BROWDEL CASE KEY=M_PGUP .OR. KEY=51 DO BROWPGUP CASE KEY=M_PGDN .OR. KEY=57 DO BROWPGDN CASE KEY=M_HOME .OR. KEY=55 DO BROWHOME CASE SEL='A' DO BROWADD ENDCASE ENDDO SET DELETED ON RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWPAGE REC_TOP=RECNO() @ ROW_TOP-1,0 SAY '' ROW=ROW_TOP IF DELETED() ? '*' ELSE ? ' ' ENDIF ?? &DISPLINE DO WHILE ROW<ROW_BOTT .AND. .NOT. EOF() ROW=ROW+1 SKIP IF DELETED() ? '*' ELSE ? ' ' ENDIF ?? &DISPLINE ENDDO REC_BOTT=RECNO() GOTO REC_TOP CNTR=ROW+1 DO WHILE CNTR<=ROW_BOTT ? SPACE(79) CNTR=CNTR+1 ENDDO ROW=ROW_TOP SET COLOR TO I DO BROWPUT SET COLOR TO RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWDOWN DO BROWPUT IF ROW<ROW_BOTT .AND. .NOT. EOF() SKIP ROW=ROW+1 SET COLOR TO I DO BROWPUT SET COLOR TO ELSE IF EOF() SKIP -1 ENDIF DO BROWPAGE ENDIF RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWUP DO BROWPUT IF .NOT. BOF() SKIP -1 ROW=ROW-1 IF ROW<ROW_TOP DO BROWPAGE ELSE SET COLOR TO I DO BROWPUT SET COLOR TO ENDIF ENDIF RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWEDIT @ 24,0 CLEAR @ 24,0 SAY ' *** Now in EDIT mode ***' @ ROW,1 GET &F1 IF FC>1 @ ROW,COL()+1 GET &F2 IF FC>2 @ ROW,COL()+1 GET &F3 IF FC>3 @ ROW,COL()+1 GET &F4 ENDIF ENDIF ENDIF READ @ 24,0 SAY COMMLINE DO BROWDOWN RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWPUT @ ROW,1 SAY &F1 IF FC>1 @ ROW,COL()+1 SAY &F2 IF FC>2 @ ROW,COL()+1 SAY &F3 IF FC>3 @ ROW,COL()+1 SAY &F4 ENDIF ENDIF ENDIF RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWSEEK REC=RECNO() SEEK_KEY=SPACE(LEN(&F1)) @ 24,0 CLEAR @ 24,0 SAY 'Seek Key ' GET SEEK_KEY READ SEEK_KEY=TRIM(SEEK_KEY) SEEK SEEK_KEY IF EOF() @ 24,0 CLEAR @ 24,0 SAY 'Seek key '+SEEK_KEY+' not found ! Press a key to continue.' DO WHILE INKEY()=0 ENDDO GOTO REC ELSE DO BROWPAGE ENDIF @ 24,0 CLEAR @ 24,0 SAY COMMLINE RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWPGUP GOTO REC_TOP SKIP -(REC_PAGE) DO BROWPAGE RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWPGDN GOTO REC_BOTT IF BOF() SKIP -1 ENDIF DO BROWPAGE RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWDEL IF DELETED() RECALL @ ROW,0 SAY ' ' ELSE DELETE @ ROW,0 SAY '*' ENDIF RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWHOME GOTO TOP DO BROWPAGE RETURN * ***************************************************************************** ***************************************************************************** * PROCEDURE BROWADD DO BROWPUT GOTO BOTT DO BROWPAGE @ 22,0 CLEAR @ 22,0 SAY 'Now at bottom of file - ready to add entry below. Blank to quit.' DO WHILE .T. M_F1=SPACE(LEN(&F1)) @ 23,0 CLEAR @ 23,1 GET M_F1 IF FC>1 M_F2=SPACE(LEN(&F2)) @ 23,COL()+1 GET M_F2 IF FC>2 M_F3=SPACE(LEN(&F3)) @ 23,COL()+1 GET M_F3 IF FC>3 M_F4=0.0 @ 23,COL()+1 GET M_F4 PICTURE '999.9' ENDIF ENDIF ENDIF READ IF UPDATE() APPEND BLANK REPLACE &F1 WITH M_F1 IF FC>1 REPLACE &F2 WITH M_F2 IF FC>2 REPLACE &F3 WITH M_F3 IF FC>3 REPLACE &F4 WITH M_F4 ENDIF ENDIF ENDIF @ ROW,0 SAY '+' DO BROWPUT ROW=ROW+1 IF ROW>ROW_BOTT DO BROWPAGE DO BROWPUT ENDIF ELSE EXIT ENDIF ENDDO @ 22,0 CLEAR DO BROWPAGE @ 24,0 SAY COMMLINE RETURN * ***************************************************************************** ***************************************************************************** * * end of function BROW * *****************************************************************************